home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Merciful 2
/
Merciful - Disc 2.iso
/
software
/
m
/
muiv3.1cracked.lha
/
MUI
/
Developer
/
Oberon
/
examples
/
PopupDemo.mod
< prev
next >
Wrap
Text File
|
1995-11-19
|
10KB
|
174 lines
MODULE PopupDemo;
IMPORT
ASL,
Dos,
e := Exec,
m := Mui,
mb := MuiBasics,
u := Utility,
y := SYSTEM;
PROCEDURE StrObjFunc*( h : mb.Hook; pop : m.Object; str : mb.Args ):LONGINT;
VAR x, s : e.STRPTR;
i : INTEGER;
BEGIN
mb.Get( y.VAL( m.Object, str ), m.aStringContents, s );
i := 0;
LOOP
m.DoMethod( pop, m.mListGetEntry, i, y.ADR( x ) );
IF x = NIL THEN
mb.Set( pop, m.aListActive, m.vListActiveOff );
EXIT;
ELSIF (x^ = s^) THEN
mb.Set( pop, m.aListActive, i );
EXIT;
END;
INC( i );
END;
RETURN e.true;
END StrObjFunc;
PROCEDURE ObjStrFunc(h : mb.Hook; pop : m.Object; str : mb.Args ):LONGINT;
VAR x : e.STRPTR;
BEGIN
m.DoMethod( pop, m.mListGetEntry, m.vListGetEntryActive, y.ADR( x ) );
mb.Set( y.VAL( m.Object, str ), m.aStringContents, x );
RETURN e.true;
END ObjStrFunc;
PROCEDURE WindowFunc(h : mb.Hook; pop : m.Object; win : mb.Args ):LONGINT;
BEGIN
mb.Set( y.VAL( m.Object, win ), m.aWindowDefaultObject, pop );
RETURN e.true;
END WindowFunc;
TYPE PopNames = ARRAY 20 OF e.STRPTR;
CONST popNames = PopNames(
y.ADR( "Stefan Becker" ),
y.ADR( "Martin Berndt" ),
y.ADR( "Dirk Federlein" ),
y.ADR( "Georg Heßmann" ),
y.ADR( "Martin Horneffer" ),
y.ADR( "Martin Huttenloher" ),
y.ADR( "Kai Iske" ),
y.ADR( "Oliver Kilian" ),
y.ADR( "Franke Mariak" ),
y.ADR( "Klaus Melchior" ),
y.ADR( "Armin Sander" ),
y.ADR( "Matthias Scheler" ),
y.ADR( "Andreas Schildbach" ),
y.ADR( "Wolfgang Schildbach" ),
y.ADR( "Christian Scholz" ),
y.ADR( "Markus Stipp" ),
y.ADR( "Ibrahim Solmaz" ),
y.ADR( "Henri Veistera" ),
y.ADR( "Albert Weinert" ),
NIL );
VAR
StrObjHook, ObjStrHook, WindowHook : mb.Hook;
app, window, pop1, pop2, pop3, pop4, pop5, plist : m.Object;
signals : LONGSET;
running : BOOLEAN;
active : LONGINT;
BEGIN
running := TRUE;
StrObjHook := mb.MakeHook( StrObjFunc );
ObjStrHook := mb.MakeHook( ObjStrFunc );
WindowHook := mb.MakeHook( WindowFunc );
mb.ApplicationObject( m.aApplicationTitle, y.ADR( "Popup-Demo" ),
m.aApplicationVersion, y.ADR( "$VER: Popup-Demo_Oberon 1.0 (19.08.94)" ),
m.aApplicationCopyright, y.ADR( "© 1993-94 Stefan Stuntz/Albert Weinert" ),
m.aApplicationAuthor, y.ADR( "Stefan Stuntz/Albert Weinert" ),
m.aApplicationDescription,y.ADR( "Demonstrate popup objects."),
m.aApplicationBase, y.ADR( "POPUP" ),
u.done );
mb.SubWindow; mb.WindowObject( m.aWindowTitle, y.ADR( "Popup Objects" ),
m.aWindowID, 1234,
u.done );
mb.WindowContents; mb.VGroup;
mb.Child; mb.ColGroup( 2 );
mb.Child; mb.keyLabel2("File:", "f");
mb.Child; mb.PopaslObject;
mb.Tag( m.aPopstringString); mb.keyString(NIL, 256, "f" );
mb.Tag( m.aPopstringButton); mb.popButton(m.iPopFile);
mb.TagItem( ASL.titleText, y.ADR( "Please selecte a file...") );
pop1 := mb.End();
mb.Child; mb.keyLabel2("Drawer:", "d");
mb.Child; mb.PopaslObject;
mb.Tag( m.aPopstringString); mb.keyString(NIL, 256, "d" );
mb.Tag( m.aPopstringButton); mb.popButton(m.iPopDrawer);
mb.TagItem2( ASL.titleText, y.ADR( "Please selecte a file..."),
ASL.frDrawersOnly, e.true );
pop2 := mb.End();
mb.Child; mb.keyLabel2("Font:", "f");
mb.Child; mb.PopaslObject;
mb.Tag( m.aPopstringString); mb.keyString(NIL, 256, "f" );
mb.Tag( m.aPopstringButton); mb.popButton(m.iPopUp);
mb.TagItem2( m.aPopaslType, ASL.fontRequest,
ASL.titleText, y.ADR( "Please select a fixed font.." ) );
pop3 := mb.End();
mb.Child; mb.keyLabel2("Fixed Font:", "i");
mb.Child; mb.PopaslObject;
mb.Tag( m.aPopstringString); mb.keyString(NIL, 256, "i" );
mb.Tag( m.aPopstringButton); mb.popButton(m.iPopUp);
mb.TagItem3( m.aPopaslType, ASL.fontRequest,
ASL.titleText, y.ADR( "Please select a fixed font.." ),
ASL.foFixedWidthOnly, e.true );
pop4 := mb.End();
mb.Child; mb.keyLabel2("Thanks To:", "n" );
mb.Child; mb.PopobjectObject;
mb.Tag( m.aPopstringString); mb.keyString(NIL, 256, "n" );
mb.Tag( m.aPopstringButton); mb.popButton(m.iPopUp);
mb.TagItem3( m.aPopobjectStrObjHook, StrObjHook,
m.aPopobjectObjStrHook, ObjStrHook,
m.aPopobjectWindowHook, WindowHook );
mb.Tag( m.aPopobjectObject ); mb.ListviewObject;
mb.Tag( m.aListviewList ); mb.ListObject;
mb.InputListFrame;
mb.TagItem( m.aListSourceArray, y.ADR( popNames) );
mb.end;
plist := mb.End();
pop5 := mb.End();
mb.end; (* ColGroup(2) *);
mb.end; (* VGroup *)
window := mb.End(); (* WindowObjects *)
app := mb.End(); (* ApplicationObject *);
IF app # NIL THEN
m.DoMethod( window, m.mNotify, m.aWindowCloseRequest, e.true,
app, 2, m.mApplicationReturnID, m.vApplicationReturnIDQuit );
m.DoMethod( window, m.mWindowSetCycleChain, pop1, pop2, pop3, pop4, pop5, NIL );
(* A double click terminates the popping lsit with a succesful return value *)
m.DoMethod( plist, m.mNotify, m.aListviewDoubleClick, e.true,
pop5, 2, m.mPopstringClose, e.true );
mb.Set( window, m.aWindowOpen, e.true );
WHILE running DO
CASE m.DOMethod( app, m.mApplicationInput, y.ADR( signals )) OF
| m.vApplicationReturnIDQuit :
mb.Get( pop1, m.aPopaslActive, active );
IF active = e.false THEN mb.Get( pop2, m.aPopaslActive, active ); END;
IF active = e.false THEN mb.Get( pop3, m.aPopaslActive, active ); END;
IF active = e.false THEN mb.Get( pop4, m.aPopaslActive, active ); END;
IF active = e.false THEN mb.Get( pop5, m.aPopaslActive, active ); END;
IF active # e.false THEN
IF m.Request( app, window, 0, NIL, "OK", "Cannot quit now, still\nsome als popups opened." ) = 0 THEN END;
ELSE
running := FALSE;
END;
ELSE END;
IF running & (signals # LONGSET{}) THEN signals := e.Wait( signals ) END;
END;
mb.Set( window, m.aWindowOpen, e.false );
ELSE
Dos.PrintF( "Failed to create Application.\n" );
m.DisposeObject( window );
END;
CLOSE
IF app # NIL THEN m.DisposeObject( app ) END;
END PopupDemo.